PC-SIG Library 8

home *** CD-ROM | disk | FTP | other *** search

/ PC-SIG Library 8 / PC-SIG Library CD-ROM (8th Edition) (1990-04).iso / 201_300 / disk0214 / ctransfe.bas < prev next >

Wrap

BASIC Source File | 1983-03-10 | 25.3 KB | 781 lines

4 DEFINT A-W,Y-Z 5 DIM F$(17),FLDN$(17,30),FTY(17,30),FL(17,30),IOPT(30) 13 DIM L(17),NREC(17) 14 DIM SN$(30),SFN(30),DTOPT(10) 21 DIM TX(10,10) 22 DIM D(10),TFN(10),FLDTCT(10,50,1),KTSUM(10),SUMFN(10) 23 DIM SUMF(10,30),KTSUMAF(30),SAFFN(30),SAFADD(10,30),SAFACCTO(10,30) 24 DIM SAFFLDN(10,30) 25 DIM S#(30) 26 DIM MAX(5,30),Z%(10),SU#(30),D#(30),EFN(10,30) 35 DIM K$(80) 42 DIM SUM(30),MAXK(10),SUMRN(10,30),SUMFLDN(10,30),MAXSAF(5) 44 DIM SUMAFOPT(30),SUMOPT(30),RNTNBOPT(10),DY(30),FLDTC(10,50,1) 46 DIM SUMFLD(10,30) 50 D = 1 70 CH = 29 75 PRINT "MEMORY FREE",FRE(0) 80 GOSUB 52000 100 GOSUB 50000 200 GOTO 20000 500 REM ******* CLS 510 CLS 520 RETURN 20000 REM ********** TRANSFER PROGRAM ********* 20010 GOSUB 500 20100 GOSUB 24620 20120 GOSUB 500 20130 HLD = 0 20140 PRINT "************ DATA TRANSFER DESCRIPTION MENU **************" 20160 PRINT "" 20180 PRINT " 0 - EXIT " 20190 PRINT "" 20200 PRINT " 1 - ENTER A TRANSFER DESCRIPTION" 20210 PRINT "" 20220 PRINT " 2 - READ A SINGLE TRANSFER DESCRIPTION" 20230 PRINT "" 20240 PRINT " 3 - PRINT ON PAPER ONE TRANSFER DESCRIPTION " 20260 PRINT "" 20280 PRINT "********** ENTER THE NUMBER THEN PRESS RETURN ************" 20300 GOSUB 60000 20302 IF DT# <0 OR DT#> 3 GOTO 20300 20310 T = DT# 20315 IF T = 0 GOTO 51000 20320 ON T GOTO 20340,20420,20640 20340 REM *** ENTER A TRANSFER DESCRIPTION *** 20360 GOSUB 20820 20380 GOSUB 24020 20400 GOTO 20120 20420 REM *** READ A SINGE TRANSFER DESCRIPTION *** 20440 GOSUB 500 20460 PRINT "******* WHICH TRANSFER DESCRIPTION DO YOU WANT TO SEE *******" 20480 FOR T = 1 TO MAXS 20500 PRINT T;"- ";SN$(T) 20520 NEXT T 20540 PRINT "************ ENTER THE NUMBER THEN PRESS RETURN *************" 20560 GOSUB 60000 20562 IF DT# <1 OR DT#> MAXS GOTO 20560 20570 S = DT# 20580 GOSUB 25220 20600 PRINT "******* PRESS ANY KEY TO CONTINUE *******" 20610 IF INKEY$ = "" THEN GOTO 20610 20620 GOTO 20120 20640 REM *** PRINT ON PAPER ONE TRANSFER DESCRIPTION *** 20660 PRINT "***** WHAT TRANSFER DESCRIPTION DO YOU WANT PRINTED *****" 20680 FOR T = 1 TO MAXS 20700 PRINT T;"- ";SN$(T) 20720 NEXT T 20740 PRINT "********** ENTER THE NUMBER THEN PRESS RETURN ***********" 20760 GOSUB 60000 20762 IF DT# <1 OR DT#> MAXS GOTO 20760 20770 S = DT# 20780 GOSUB 26500 20800 GOTO 20120 20820 REM ************ NEW TRANSFER ENTRY ************* 20840 GOSUB 500 20860 PRINT "**************** NEW TRANSFER DATA ENTRY ****************" 20880 PRINT "" 20900 PRINT "***** WHAT NUMBER IS THIS DATA TRANSFER OPTION *****" 20920 FOR T = 1 TO MAXS 20940 PRINT T;"-";SN$(T) 20960 NEXT T 20980 PRINT " ------ ENTER A NUMBER FROM 1 TO ";MAXS+1;" ------" 21000 PRINT "********* ENTER ZERO TO RETURN TO FIRST MENU ********" 21020 GOSUB 60000 21022 IF DT# <0 OR DT#> MAXS +1 GOTO 21020 21026 IF DT# = 0 GOTO 20000 21030 S = DT# 21040 IF S > MAXS +1 THEN GOTO 20840 21060 IF S > MAXS THEN MAXS = S 21080 PRINT "**** WHAT NAME DO YOU WANT TO GIVE THIS TRANSFER ****" 21090 MAX = 40 21100 GOSUB 62030 21110 SN$(S) = A$ 21120 GOSUB 500 21130 PRINT "************* WHICH FILE IS THE SOURCE FILE *************" 21140 FOR T = 1 TO MAXF 21160 PRINT T;"-";F$(T) 21180 NEXT T 21200 PRINT "***** ENTER THE SOURCE FILE NUMBER THEN PRESS RETURN *****" 21210 GOSUB 60000 21212 IF DT# <1 OR DT#> MAXF GOTO 21210 21215 SFN(S) = DT# 21220 SFN = SFN(S) 21230 DY(SFN) = NREC(SFN) 21240 PRINT "********* DIRECT DATA TRANSFER OPTION **********" 21260 PRINT " 1 - TRANSFER" 21280 PRINT " 2 - NO TRNASFER" 21290 PRINT "****** ENTER THE NUMBER THEN PRESS RETURN ******" 21300 GOSUB 60000 21302 IF DT# <1 OR DT#> 2 GOTO 21300 21310 DTOPT(S) = DT# 21320 IF DTOPT(S) = 2 GOTO 22040 21340 GOSUB 500 21350 PRINT "*************** WHICH FILE IS THE TARGET FILE *************" 21360 FOR T = 1 TO MAXF 21380 PRINT T;"-";F$(T) 21400 NEXT T 21410 PRINT "****** ENTER THE TARGET FILE NUMBER THEN PRESS RETURN ******" 21420 GOSUB 60000 21422 IF DT# <1 OR DT#> MAXF GOTO 21420 21430 TFN(S) = DT# 21440 TFN = TFN(S) 21460 GOSUB 500 21480 PRINT "************ RECORD NUMBERING FOR TARGET OPTION ************" 21500 PRINT " 0 - EQUALS SOURCE FILE NUMBER " 21510 PRINT " Record Number of target is = to the value of source field :" 21520 FOR T = 1 TO NREC(SFN) 21540 PRINT " ";T;"-";FLDN$(SFN,T) 21560 NEXT T 21580 PRINT "*************** ENTER NUMBER THEN PRESS RETURN **************" 21590 GOSUB 60000 21592 IF DT# <0 OR DT#> NREC(SFN) GOTO 21590 21594 IF FTY(SFN,DT#) = 1 GOTO 21590 21600 RNTNBOPT(S) = DT# 21620 D = 1 21640 FOR N = 1 TO NREC(TFN) 21660 GOSUB 500 21680 PRINT "FIELD #";N;" ";FLDN$(TFN,N) 21700 PRINT "************* FIELD TARGET CHANGE *************" 21720 PRINT " 1 -DO NOT CHANGE " 21730 PRINT " Change with source field :" 21740 FOR T = 1 TO NREC(SFN) 21760 PRINT " ";T+1;"-";FLDN$(SFN,T) 21780 NEXT T 21800 PRINT "***** ENTER THE NUMBER THEN PRESS RETURN ******" 21810 T4 = NREC(SFN) + 1 21820 GOSUB 60000 21822 IF DT# <1 OR DT#> T4 GOTO 21820 21823 IF DT# = 1 GOTO 21830 21824 T2 = DT# 21827 IF FTY(SFN,T2-1) >< FTY(TFN,N) GOTO 21820 21830 FLDTC(S,N,D) = DT# 21840 IF FLDTC(S,N,D) = 1 GOTO 21980 21860 PRINT "****************** TYPE OF CHANGE *****************" 21880 PRINT " 1 - ADD -source field and target field" 21900 PRINT " 2 - REPLACE -target field equals source field" 21920 PRINT " 3 - SUBTRACT -target field minus source field" 21940 PRINT "******* ENTER THE NUMBER THEN PRESS RETURN ********" 21950 GOSUB 60000 21952 IF DT# <1 OR DT#> 3 GOTO 21950 21954 IF FTY(TFN,N) = 1 AND DT# >< 2 GOTO 21950 21960 FLDTCT(S,N,D) = DT# 21980 NEXT N 22000 IF D = 2 GOTO 22040 22020 GOSUB 500 22040 REM ******** SUM OPTION ******* 22080 PRINT "********** SUM ACCORDING TO FIELD OPTION ***********" 22100 PRINT " 1 - SUM" 22120 PRINT " 2 - DO NOT SUM" 22130 PRINT "******** ENTER THE NUMBER THEN PRESS RETURN ********" 22140 GOSUB 60000 22142 IF DT# <1 OR DT#> 2 GOTO 22140 22150 SUMOPT(S) = DT# 22160 IF SUMOPT(S) = 2 GOTO 22720 22180 GOSUB 500 22200 A = SFN(S) 22220 GOSUB 23400 22240 PRINT "***** HOW MANY FIELDS DO YOU WANT SUMMED *****" 22260 PRINT "***** ENTER THE NUMBER THEN PRESS RETURN *****" 22280 GOSUB 60000 22282 IF DT# <1 OR DT#> NREC(SFN) GOTO 22280 22290 KTSUM(S) = DT# 22300 FOR K = 1 TO KTSUM(S) 22320 GOSUB 500 22340 GOSUB 23400 22360 PRINT "WHICH FIELD IS THE ";K;"th FIELD YOU WANT SUMED" 22380 GOSUB 60000 22382 IF DT# <1 OR DT#> NREC(SFN) GOTO 22280 22384 IF FTY(SFN,DT#) = 1 GOTO 22280 22390 SUMF(S,K) = DT# 22400 GOSUB 500 22410 PRINT "******* WHICH FILE DO YOU WANT THIS SUM SENT TO *******" 22415 PRINT "The file must be the same for all sums." 22420 PRINT "" 22440 FOR N = 1 TO MAXF 22460 PRINT "FILE NUMBER ";N;" FILE NAME ";F$(N) 22480 NEXT N 22500 PRINT "" 22520 PRINT "******* WHICH FILE DO YOU WANT THIS SUM SENT TO *******" 22540 GOSUB 60000 22542 IF DT# <1 OR DT#> MAXF GOTO 22540 22545 IF (HLD > 0) AND (DT# <> HLD) GOTO 22540 22547 HLD = DT# 22550 SUMFN(S) = DT# 22560 PRINT "*** WHICH RECORD NUMBER DO YOU WANT THE SUM SENT TO ***" 22565 GOSUB 60000 22567 IF DT# <1 GOTO 22565 22570 SUMRN(S,K) = DT# 22580 GOSUB 500 22590 PRINT "******* WHICH FIELD DO YOU WANT THIS SUM SENT TO ********" 22600 SFN = SFN(S) 22620 FOR P = 1 TO NREC(HLD) 22640 PRINT "FIELD #";P;FLDN$(HLD,P) 22660 NEXT P 22680 PRINT "***** WHICH FIELD NUMBER DO YOU WANT THE SUM SENT TO *****" 22685 GOSUB 60000 22687 IF DT# <1 OR DT#> NREC(HLD) GOTO 22685 22688 IF FTY(HLD,DT#) = 1 GOTO 22685 22690 SUMFLDN(S,K) = DT# 22700 NEXT K 22720 REM ********* SUM ACCORDING TO ANOTHER FIELD OPTION ********** 22740 GOSUB 500 22760 PRINT "******* SUM WITH SUBTOTALS BY ANOTHER FIELD ******" 22780 PRINT " 1 - SUM" 22800 PRINT " 2 - DO NOT SUM" 22810 PRINT "******** ENTER THE NUMBER THEN PRESS RETURN ******" 22815 GOSUB 60000 22816 IF DT# <1 OR DT#> 2 GOTO 22815 22820 SUMAFOPT(S) = DT# 22840 IF SUMAFOPT(S) = 2 THEN GOTO 23380 22860 FOR T = 1 TO NREC(SFN) 22880 PRINT T;"-";FLDN$(SFN,T) 22900 NEXT T 22910 PRINT "****** NUMBER OF FIELDS YOU WANT ADDED ******" 22920 GOSUB 60000 22922 IF DT# <1 OR DT#> NREC(SFN) GOTO 22920 22930 KTSUMAF(S) = DT# 22940 FOR K = 1 TO KTSUMAF(S) 22960 GOSUB 500 22980 SFN = SFN(S) 23000 PRINT "" 23020 FOR N = 1 TO NREC(SFN) 23040 PRINT "FIELD # ";N;" ";FLDN$(SFN,N) 23060 NEXT N 23080 PRINT "" 23100 PRINT "************** WHAT FIELD DO YOU WANT SUMMED ****************" 23105 GOSUB 60000 23107 IF DT# <1 OR DT#> NREC(SFN) GOTO 23105 23108 IF FTY(SFN,DT#) = 1 GOTO 23105 23110 SAFADD(S,K) = DT# 23120 PRINT "**** WHAT FIELD DO YOU WANT THE SUBTOTALS GROUPED BY ******" 23125 GOSUB 60000 23127 IF DT#< 1 OR DT# >NREC(SFN) GOTO 23125 23128 IF FTY(SFN,DT#) >< 2 GOTO 23125 23130 SAFACCTO(S,K) = DT# 23140 GOSUB 500 23160 PRINT "" 23180 FOR A = 1 TO MAXF 23200 PRINT "FILE # ";A;" ";F$(A) 23220 NEXT A 23240 PRINT "" 23260 PRINT "*********** WHAT FILE DO YOU WANT THE SUM IN *********" 23265 GOSUB 60000 23267 IF DT#< 1 OR DT# >MAXF GOTO 23265 23268 IF HLD > 0 AND DT# >< HLD GOTO 23265 23269 HLD = DT# 23270 SAFFN(S) = DT# 23280 A = SAFFN(S) 23300 GOSUB 23400 23320 PRINT "*********** WHAT FIELD DO YOU WANT THE SUM IN *********" 23325 GOSUB 60000 23327 IF DT#< 1 OR DT# >NREC(A) GOTO 23325 23328 IF FTY(A,DT#) = 1 GOTO 23325 23330 SAFFLDN(S,K) = DT# 23360 NEXT K 23380 RETURN 23400 PRINT "-------------------------------------------------------------------------------" 23420 PRINT "FILE NUMBER : ";A 23440 PRINT "FILE NAME : "; F$(A) 23460 PRINT "NUMBER OF FIELDS : ";NREC(A) 23480 PRINT "RECORD LENGTH : ";L(A) 23500 FOR N = 1 TO NREC(A) 23520 PRINT N ;TAB(5);FLDN$(A,N); 23540 ON FTY(A,N) GOTO 23560,23600,23640,23680,23690 23560 PRINT " STRING WITH MAXIMUM LENGTH ";FL(A,N) 23580 GOTO 23700 23600 PRINT " INTEGER " 23620 GOTO 23700 23640 PRINT " SINGLE PRECISION " 23660 GOTO 23700 23680 PRINT " DOUBLE PRECISION " 23685 GOTO 23700 23690 PRINT " DOLLAR AND CENTS AMOUNT " 23700 REM *** 23720 NEXT N 23740 PRINT "-------------------------------------------------------------------------------" 23760 RETURN 23780 REM ************* READ SUBROUTINE ************* 23800 OPEN "I",#1,"FFILE" 23820 INPUT #1,MAXF 23840 FOR A = 1 TO MAXF 23860 INPUT #1,A,F$(A),NREC(A),L(A) 23880 FOR N = 1 TO NREC(A) 23900 INPUT #1,FLDN$(A,N),FTY(A,N),FL(A,N) 23920 IF FTY(A,N) = 2 THEN INPUT #1,D,D 23940 NEXT N 23960 NEXT A 23980 CLOSE #1 24000 RETURN 24020 REM ************ OPEN FOR OUTPUT ************** 24040 OPEN "O",#2,"TFER" 24060 WRITE #2,MAXS 24080 FOR S = 1 TO MAXS 24100 D = 1 24120 WRITE #2,DTOPT(S),SUMOPT(S),SUMAFOPT(S),SN$(S),SFN(S) 24140 IF DTOPT(S) = 2 GOTO 24360 24160 WRITE #2,RNTNBOPT(S),D(S),TFN(S),NREC(TFN) 24180 TFN = TFN(S) 24200 FOR N = 1 TO NREC(TFN) 24220 WRITE #2,FLDTC(S,N,D) 24240 IF FLDTC(S,N,D) = 1 GOTO 24280 24260 WRITE #2,FLDTCT(S,N,D) 24280 NEXT N 24300 IF D = 2 GOTO 24360 24320 IF D(S) = 2 THEN D = 2 24340 IF D(S) = 2 GOTO 24200 24360 IF SUMOPT(S) = 2 GOTO 24460 24380 WRITE #2,KTSUM(S),SUMFN(S) 24400 FOR K = 1 TO KTSUM(S) 24420 WRITE #2,SUMF(S,K),SUMRN(S,K),SUMFLDN(S,K) 24440 NEXT K 24460 IF SUMAFOPT(S) = 2 GOTO 24560 24480 WRITE #2, KTSUMAF(S),SAFFN(S) 24500 FOR K = 1 TO KTSUMAF(S) 24520 WRITE #2,SAFADD(S,K),SAFACCTO(S,K),SAFFLDN(S,K),MAX(S,K) 24540 NEXT K 24560 NEXT S 24580 CLOSE #2 24600 RETURN 24620 REM ************ OPEN FOR INPUT ************** 24640 OPEN "I",#2,"TFER" 24660 INPUT #2,MAXS 24680 FOR S = 1 TO MAXS 24700 D = 1 24720 INPUT #2,DTOPT(S),SUMOPT(S),SUMAFOPT(S),SN$(S),SFN(S) 24740 IF DTOPT(S) = 2 GOTO 24960 24760 INPUT #2,RNTNBOPT(S),D(S),TFN(S),DY(S) 24780 TFN = TFN(S) 24800 FOR N = 1 TO DY(S) 24820 INPUT #2,FLDTC(S,N,D) 24840 IF FLDTC(S,N,D) = 1 GOTO 24880 24860 INPUT #2,FLDTCT(S,N,D) 24880 NEXT N 24900 IF D = 2 GOTO 24960 24920 IF D(S) = 2 THEN D = 2 24940 IF D(S) = 2 GOTO 24800 24960 IF SUMOPT(S) = 2 GOTO 25060 24980 INPUT #2,KTSUM(S),SUMFN(S) 25000 FOR K = 1 TO KTSUM(S) 25020 INPUT #2,SUMF(S,K),SUMRN(S,K),SUMFLDN(S,K) 25040 NEXT K 25060 IF SUMAFOPT(S) = 2 GOTO 25160 25080 INPUT #2, KTSUMAF(S),SAFFN(S) 25100 FOR K = 1 TO KTSUMAF(S) 25120 INPUT #2,SAFADD(S,K),SAFACCTO(S,K),SAFFLDN(S,K),MAX(S,K) 25140 NEXT K 25160 NEXT S 25180 CLOSE #2 25200 RETURN 25220 REM ************ PRINT OUT INF0 ************** 25240 PRINT "NUMBER OF DIFFERENT TRANSFER: ";MAXS 25260 PRINT "TRANSFER NUMBER: ";S 25280 PRINT "TRANSFER NAME : ";SN$(S) 25300 PRINT "SOURCE FILE NUMBER :";SFN(S);" ";F$(SFN(S)) 25320 PRINT "THIS TRANSFER CONTAINS :" 25340 IF DTOPT(S) = 1 THEN PRINT "--DIRECT TRANSFER " 25360 IF DTOPT(S) = 2 THEN PRINT "--NO DIRECT TRANSFER " 25380 IF SUMOPT(S) = 1 THEN PRINT "--SUM FIELDS" 25400 IF SUMOPT(S) = 2 THEN PRINT "--DO NOT SUM FIELDS" 25420 IF SUMAFOPT(S) = 1 THEN PRINT "--SUM ACCORDING TO ANOTHER FIELD " 25440 IF SUMAFOPT(S) = 2 THEN PRINT "--DO NOT SUM ACCORDING TO ANOTHER FIELD " 25460 IF DTOPT(S) = 2 GOTO 25900 25480 SFN = SFN(S) 25500 PRINT "****** DIRECT TRANSFER ******" 25520 PRINT "TARGET RECORD NUMBER "; 25540 IF RNTNBOPT(S) = 0 THEN GOTO 25620 25560 T1 = RNTNBOPT(S) 25580 PRINT "= SOURCE FILE FIELD ";RNTNBOPT(S);"- ";FLDN$(SFN,T1) 25600 GOTO 25640 25620 PRINT "AUTOMATICALLY INCREMENTS " 25640 PRINT "TARGET FILE NUMBER :";TFN(S);" ";F$(TFN(S)) 25660 TFN = TFN(S) 25680 FOR N = 1 TO DY(S) 25700 PRINT "FIELD ";N;"-"; 25720 IF FLDTC(S,N,1) = 1 THEN PRINT "- NO CHANGE" 25740 IF FLDTC(S,N,1) = 1 GOTO 25880 25760 T1 = FLDTC(S,N,1)-1 25780 IF FLDTC(S,N,1) = 1 GOTO 25880 25800 PRINT "- CHANGED BY SOURCE FIELD ";T1;"- ";FLDN$(SFN,T1); 25820 IF FLDTCT(S,N,1) = 1 THEN PRINT " - ADDED TO " 25840 IF FLDTCT(S,N,1) = 2 THEN PRINT " - REPLACED BY" 25860 IF FLDTCT(S,N,1) = 3 THEN PRINT " - SUBTRACT FROM " 25880 NEXT N 25900 IF SUMOPT(S) = 2 GOTO 26140 25920 PRINT "******* SUM FIELDS *******" 25940 PRINT "NUMBER OF SUMS ";KTSUM(S) 25960 PRINT "ALL SUMS GO TO THIS FILE ";SUMFN(S);" ";F$(SUMFN(S)) 25980 TFN = SUMFN(S) 26000 FOR K = 1 TO KTSUM(S) 26020 PRINT "****** SUM NUMBER ";K;" *******" 26040 PRINT " FIELD SUMMED = ";SUMF(S,K);FLDN$(SFN,T1) 26060 PRINT " RECORD WHERE SUM GOES ";SUMRN(S,K) 26080 T1 = SUMFLDN(S,K) 26100 PRINT " FIELD WHERE SUM GOES ";SUMFLDN(S,K);" ";FLDN$(TFN,T1) 26120 NEXT K 26140 IF SUMAFOPT(S) = 2 GOTO 26460 26160 PRINT "******* SUM FIELDS ACCORDING TO ANOTHER FIELD *******" 26180 PRINT "NUMBER OF SUMS BY ANOTHER FIELD ";KTSUMAF(S) 26200 T1 = SAFFN(S) 26220 PRINT "ALL SUMS GO TO THIS FILE ";SAFFN(S);F$(T1) 26240 TFN = SAFFN(S) 26260 FOR K = 1 TO KTSUMAF(S) 26280 PRINT "****** SUMS NUMBER ";K;" *******" 26300 T1 = SAFADD(S,K) 26320 PRINT "SUM THIS FIELD ";SAFADD(S,K);" ";FLDN$(SFN,T1) 26340 T1 = SAFACCTO(S,K) 26360 PRINT "BY THIS FIELD ";SAFACCTO(S,K);" ";FLDN$(SFN,T1) 26380 T1 = SAFFLDN(S,K) 26400 PRINT "SUM GOES TO THIS FIELD ";SAFFLDN(S,K);" ";FLDN$(TFN,T1) 26440 NEXT K 26460 REM *** 26480 RETURN 26500 REM ************ PRINT OUT INF0 ************** 26520 LPRINT "NUMBER OF DIFFERENT TRANSFER: ";MAXS 26540 LPRINT "TRANSFER NUMBER: ";S 26560 LPRINT "TRANSFER NAME : ";SN$(S) 26580 LPRINT "SOURCE FILE NUMBER :";SFN(S);" ";F$(SFN(S)) 26600 LPRINT "THIS TRANSFER CONTAINS :" 26620 IF DTOPT(S) = 1 THEN LPRINT "--DIRECT TRANSFER " 26640 IF DTOPT(S) = 2 THEN LPRINT "--NO DIRECT TRANSFER " 26660 IF SUMOPT(S) = 1 THEN LPRINT "--SUM FIELDS" 26680 IF SUMOPT(S) = 2 THEN LPRINT "--DO NOT SUM FIELDS" 26700 IF SUMAFOPT(S) = 1 THEN LPRINT "--SUM ACCORDING TO ANOTHER FIELD " 26720 IF SUMAFOPT(S) = 2 THEN LPRINT "--DO NOT SUM ACCORDING TO ANOTHER FIELD " 26740 IF DTOPT(S) = 2 GOTO 27180 26760 SFN = SFN(S) 26780 LPRINT "****** DIRECT TRANSFER ******" 26800 LPRINT "TARGET RECORD NUMBER "; 26820 IF RNTNBOPT(S) = 0 THEN GOTO 26900 26840 T1 = RNTNBOPT(S) 26860 LPRINT "= SOURCE FILE FIELD ";RNTNBOPT(S);"- ";FLDN$(SFN,T1) 26880 GOTO 26920 26900 LPRINT "AUTOMATICALLY INCREMENTS " 26920 LPRINT "TARGET FILE NUMBER :";TFN(S);" ";F$(TFN(S)) 26940 TFN = TFN(S) 26960 FOR N = 1 TO DY(S) 26980 LPRINT "FIELD ";N;"-"; 27000 IF FLDTC(S,N,1) = 1 THEN LPRINT "- NO CHANGE" 27020 IF FLDTC(S,N,1) = 1 GOTO 27160 27040 T1 = FLDTC(S,N,1)-1 27060 IF FLDTC(S,N,1) = 1 GOTO 27160 27080 LPRINT "- CHANGED BY SOURCE FIELD ";T1;"- ";FLDN$(SFN,T1); 27100 IF FLDTCT(S,N,1) = 1 THEN LPRINT " - ADDED TO " 27120 IF FLDTCT(S,N,1) = 2 THEN LPRINT " - REPLACED BY" 27140 IF FLDTCT(S,N,1) = 3 THEN LPRINT " - SUBTRACT FROM " 27160 NEXT N 27180 IF SUMOPT(S) = 2 GOTO 27420 27200 LPRINT "******* SUM FIELDS *******" 27220 LPRINT "NUMBER OF SUMS ";KTSUM(S) 27240 LPRINT "ALL SUMS GO TO THIS FILE ";SUMFN(S);" ";F$(SUMFN(S)) 27260 TFN = SUMFN(S) 27280 FOR K = 1 TO KTSUM(S) 27300 LPRINT "****** SUM NUMBER ";K;" *******" 27320 LPRINT " FIELD SUMMED = ";SUMF(S,K);FLDN$(SFN,T1) 27340 LPRINT " RECORD WHERE SUM GOES ";SUMRN(S,K) 27360 T1 = SUMFLDN(S,K) 27380 LPRINT " FIELD WHERE SUM GOES ";SUMFLDN(S,K);" ";FLDN$(TFN,T1) 27400 NEXT K 27420 IF SUMAFOPT(S) = 2 GOTO 27740 27440 LPRINT "******* SUM FIELDS ACCORDING TO ANOTHER FIELD *******" 27460 LPRINT "NUMBER OF SUMS BY ANOTHER FIELD ";KTSUMAF(S) 27480 T1 = SAFFN(S) 27500 LPRINT "ALL SUMS GO TO THIS FILE ";SAFFN(S);F$(T1) 27520 TFN = SAFFN(S) 27540 FOR K = 1 TO KTSUMAF(S) 27560 LPRINT "****** SUMS NUMBER ";K;" *******" 27580 T1 = SAFADD(S,K) 27600 LPRINT "SUM THIS FIELD ";SAFADD(S,K);" ";FLDN$(SFN,T1) 27620 T1 = SAFACCTO(S,K) 27640 LPRINT "BY THIS FIELD ";SAFACCTO(S,K);" ";FLDN$(SFN,T1) 27660 T1 = SAFFLDN(S,K) 27680 LPRINT "SUM GOES TO THIS FIELD ";SAFFLDN(S,K);" ";FLDN$(TFN,T1) 27720 NEXT K 27740 REM *** 27760 RETURN 50000 REM ********** INTRO 50010 GOSUB 500 50100 PRINT " T R A N S F E R D E S C R I P T I O N P R O G R A M 3.0 " 50105 PRINT "" 50110 PRINT " Copyright 1984 by Potomac Pacific Engineering Inc." 50120 PRINT "" 50130 PRINT "This program is licensed FREE to all users with some restrictions :" 50165 PRINT " See the manual for more information on the license." 50167 PRINT "" 50920 GOSUB 23780 50950 PRINT "****************** PRESS ANY KEY TO CONTINUE *******************"; 50960 IF INKEY$ = "" GOTO 50960 50970 RETURN 51000 REM ***** EXIT TO SYSTEM 51100 GOSUB 500 51110 CLOSE 51120 PRINT " -BYE, Have a nice day" 51130 END 52000 REM ***** INTRO 1 52010 GOSUB 500 52100 PRINT " Put the DATA DISK in the default disk drive " 52110 PRINT "" 52120 PRINT " ***** THEN PRESS ANY KEY TO CONTINUE *****" 52130 PRINT "" 52140 PRINT " The CUSTOM programS only use the PROGRAM DATA DISK" 52150 PRINT "Keep it in the default disk drive at all times during this program." 52200 IF INKEY$ = "" GOTO 52200 52210 RETURN 60000 REM ******* INTEGER LESS THEN 100 CHECK ******** 60010 MAX = 2 60020 ACT$ = "1234567890=<>^" 60030 IF NE = 0 THEN ACT$ = "1234567890" 60040 PRINT ">__<"; 60050 GOTO 60240 60060 REM ******* INTEGER ******* 60070 MAX = 8 60080 ACT$ = "1234567890-+,=<>^" 60090 IF NE = 0 THEN ACT$ = "1234567890-+," 60100 PRINT ">________<"; 60110 GOTO 60240 60120 REM ******* SINGLE PRECISION ******* 60130 MAX = 10 60140 ACT$ = "1234567890-+,.%$=<>^" 60150 IF NE = 0 THEN ACT$ = "1234567890+-,.%$" 60160 PRINT ">__________<"; 60170 GOTO 60240 60180 REM ******* DOUBLE PRECISION ******* 60190 MAX = 20 60200 ACT$ = "1234567890-+,.%$=<>^" 60210 IF NE = 0 THEN ACT$ = "1234567890+-,.%$" 60220 PRINT ">____________________<"; 60230 GOTO 60240 60240 REM ********** NUMBER CHECK ********** 60250 A$ = "" 60260 K$(20) = " " 60270 KTMAX = 0 60280 FOR T9 = 1 TO MAX 60290 K$(T9) = " " 60300 NEXT T9 60310 DIG$ = "1234567890." 60320 DOTFLG = 0 60330 T2 = MAX + 1 60340 FOR T6 = 1 TO T2 60350 PRINT CHR$(CH); 60360 NEXT T6 60370 IF INKEY$ = "" GOTO 60380 ELSE GOTO 60370 60380 KT = 0 60390 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH *********** 60400 KT = KT + 1 60410 REM 60420 W$ = INKEY$ 60430 IF W$ = "" GOTO 60420 60440 C = ASC(W$) 60450 IF C = 0 THEN GOSUB 61900 60460 IF C = 13 GOTO 60580 60470 IF C = 17 OR C = 8 GOTO 61150 60480 IF C = 19 GOTO 60670 60490 IF C = 4 GOTO 60720 60500 IF C = 6 GOTO 60780 60510 IF C = 1 GOTO 60960 60520 IF KT > MAX GOTO 60410 60530 IF INSTR(ACT$,W$) = 0 GOTO 61230 60540 K$(KT) = W$ 60550 PRINT K$(KT); 60560 IF KT > KTMAX THEN KTMAX = KT 60570 GOTO 60400 60580 REM ********** RETURN ********** 60590 FOR T9 = 1 TO KTMAX 60600 A$ = A$ + K$(T9) 60610 NEXT T9 60620 IF KTMAX = 0 THEN PRINT "1" 60630 IF KTMAX = 0 THEN DT# = 1 60640 IF KTMAX = 0 THEN RETURN 60650 PRINT "" 60660 GOTO 61260 60670 REM ********* MOVE CURSE BACK ******** 60680 IF KT = 1 GOTO 60410 60690 KT = KT - 1 60700 PRINT CHR$(CH); 60710 GOTO 60410 60720 REM ********* MOVE CURSER FORWARD ********* 60730 IF KT >= MAX GOTO 60410 60740 IF KT > (KTMAX + 1) GOTO 60410 60750 PRINT K$(KT); 60760 KT = KT + 1 60770 GOTO 60410 60780 REM ********** INSERT *********** 60790 IF KT > KTMAX GOTO 60410 60800 X9 = MAX 60810 WHILE X9 > KT 60820 X9 = X9 - 1 60830 K$(X9 + 1) = K$(X9) 60840 WEND 60850 K$(KT) = " " 60860 KTMAX = KTMAX + 1 60870 IF KTMAX > MAX THEN KTMAX = MAX 60880 FOR T9 = KT TO KTMAX 60890 PRINT K$(T9); 60900 NEXT T9 60910 T6 = (KTMAX - KT) + 1 60920 FOR T7 = 1 TO T6 60930 PRINT CHR$(CH); 60940 NEXT T7 60950 GOTO 60410 60960 REM ********** DELETE *********** 60970 IF KT > KTMAX GOTO 60410 60980 IF KTMAX = 1 GOTO 60410 60990 K$(MAX + 1) = "" 61000 X9 = KT 61010 WHILE X9 <= MAX 61020 K$(X9) = K$(X9 + 1) 61030 X9 = X9 + 1 61040 WEND 61050 KTMAX = KTMAX - 1 61060 FOR T9 = KT TO KTMAX 61070 PRINT K$(T9); 61080 NEXT T9 61090 PRINT "_"; 61100 T7 = (KTMAX - KT) + 2 61110 FOR T8 = 1 TO T7 61120 PRINT CHR$(CH); 61130 NEXT T8 61140 GOTO 60410 61150 REM ********* BACKSPACE ******** 61160 IF KT = 1 GOTO 60410 61170 KT = KT - 1 61180 PRINT CHR$(CH); 61190 K$(KT) = " " 61200 PRINT "_"; 61210 PRINT CHR$(CH); 61220 GOTO 60410 61230 REM ******* INPUT NOT ACCEPTABLE ******** 61240 PRINT CHR$(7); 61250 GOTO 60420 61260 REM ********* CLEAR STRINGS ******** 61270 MAX = LEN(A$) 61280 D2$ = "" 61290 D1$ = "" 61300 DFLG = 0 61310 FOR Q93 = 1 TO MAX 61320 R$ = MID$(A$,Q93,1) 61330 IF INSTR(DIG$,R$) = 0 GOTO 61400 61340 IF R$ = "." OR DFLG = 1 GOTO 61380 61350 IF DFLG = 1 GOTO 61380 61360 D2$ = D2$ + R$ 61370 GOTO 61400 61380 D1$ = D1$ + R$ 61390 DFLG = 1 61400 NEXT Q93 61410 DA# = VAL(D2$) 61420 D1# = VAL(D1$) 61430 DT# = DA# + D1# 61440 IF K$(1) = "-" THEN DT# = -DT# 61450 RETURN 61900 REM ****** CHECK FOR ASC0 61910 S4$ = INKEY$ 61920 C2 = ASC(S4$) 61930 IF C2 = 83 THEN C = 1 61940 IF C2 = 82 THEN C = 6 61950 IF C2 = 75 THEN C = 19 61960 IF C2 = 77 THEN C = 4 61970 RETURN 62000 REM ********** ALPHANUMERIC CHECK ************** 62010 MAX = FL(A,Q) 62020 GOTO 62040 62030 REM ******** MAX SET IN PROGRAM ******** 62040 A$ = "" 62050 PRINT ">"; 62060 FOR N9 = 1 TO MAX 62070 K$(N9) = "" 62080 PRINT "_"; 62090 NEXT N9 62100 PRINT "<"; 62110 T2 = MAX + 1 62120 FOR T4 = 1 TO T2 62130 PRINT CHR$(CH); 62140 NEXT T4 62150 KT = 0 62160 KTMAX = 1 62170 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH *********** 62180 KT = KT + 1 62190 PRINT TAB(KT+1)""; 62200 K$ = INKEY$ 62210 IF K$ = "" GOTO 62200 62220 C = ASC(K$) 62230 IF C = 0 THEN GOSUB 61900 62240 IF C = 13 GOTO 62350 62250 IF C = 17 OR C = 8 GOTO 62920 62260 IF C = 19 GOTO 62450 62270 IF C = 4 GOTO 62500 62280 IF C = 6 GOTO 62560 62290 IF C = 1 GOTO 62730 62300 IF KT > MAX GOTO 62190 62310 K$(KT) = K$ 62320 PRINT K$(KT); 62330 IF KT > KTMAX THEN KTMAX = KT 62340 GOTO 62180 62350 REM ********** RETURN ********** 62360 FOR T9 = 1 TO MAX 62370 A$ = A$ + K$(T9) 62420 NEXT T9 62430 PRINT "" 62440 RETURN 62450 REM ********* MOVE CURSE BACK ******** 62460 IF KT = 1 GOTO 62190 62470 KT = KT - 1 62480 PRINT CHR$(CH); 62490 GOTO 62190 62500 REM ********* MOVE CURSER FORWARD ********* 62510 IF KT >= MAX GOTO 62190 62520 IF KT > KTMAX GOTO 62190 62530 PRINT K$(KT); 62540 KT = KT + 1 62550 GOTO 62190 62560 REM ********** INSERT *********** 62570 X9 = MAX 62580 WHILE X9 > KT 62590 X9 = X9 - 1 62600 K$(X9 + 1) = K$(X9) 62610 WEND 62620 K$(KT) = " " 62630 KTMAX = KTMAX + 1 62640 IF KTMAX > MAX THEN KTMAX = MAX 62650 FOR T9 = KT TO KTMAX 62660 PRINT K$(T9); 62670 NEXT T9 62680 T6 = (KTMAX - KT) +1 62690 FOR T7 = 1 TO T6 62700 PRINT CHR$(CH); 62710 NEXT T7 62720 GOTO 62190 62730 REM ********** DELETE *********** 62740 IF KT > KTMAX GOTO 62200 62750 IF KTMAX = 1 GOTO 62190 62760 K$(MAX + 1) = "" 62770 X9 = KT 62780 WHILE X9 <= KTMAX 62790 K$(X9) = K$(X9 + 1) 62800 X9 = X9 + 1 62810 WEND 62820 KTMAX = KTMAX - 1 62830 FOR T9 = KT TO KTMAX 62840 PRINT K$(T9); 62850 NEXT T9 62860 PRINT "_"; 62870 T7 = (KTMAX - KT) + 2 62880 FOR T6 = 1 TO T7 62890 PRINT CHR$(CH); 62900 NEXT T6 62910 GOTO 62190 62920 REM ********* BACKSPACE ******** 62930 IF KT = 1 GOTO 62190 62940 K$(KT) = " " 62950 KT = KT - 1 62960 K$(KT) = " " 62970 PRINT CHR$(CH); 62980 PRINT "_"; 62990 PRINT CHR$(CH); 63000 GOTO 62190 " " 62950 KT = KT - 1 62960 K$(KT) = " " 62970 PRINT CHR$(CH); 62980 PRINT "_"; 62990 PRINT CHR$(CH); 63000 G